unit MuTests;

interface

uses SysUtils, Classes;

type
  ETestFail = class(Exception) end;
  TTestProcedure = procedure();

  PTest = ^TTest;
  TTest = record
    Name: string;
    Proc: TTestProcedure;
  end;


procedure Check(Condition: Boolean; const Msg: string); overload;
procedure Check(Condition: Boolean; const Msg: string; const Args: array of const); overload;

procedure RegisterTests(const UnitName: string; TestArray: array of TTest);
procedure Run();

implementation

procedure Check(Condition: Boolean; const Msg: string);
begin
  if Condition = True then Exit;
  raise ETestFail.Create(Msg);
end;

procedure Check(Condition: Boolean; const Msg: string; const Args: array of const);
begin
  Check(Condition, Format(Msg, Args));
end;


var
  TestList: TList;

procedure RegisterTests(const UnitName: string; TestArray: array of TTest);
var
  I: Integer;
  Test: PTest;
begin
  for I := Low(TestArray) to High(TestArray) do
  begin
    if @TestArray[I].Proc = nil then Break;
    New(Test);
    Test^ := TestArray[I];
    if UnitName <> '' then
      Test.Name := UnitName + '.' + Test.Name;
    TestList.Add(Test);
  end;
end;

procedure Run();
var
  I: Integer;
  Test: PTest;
  IsFail: Boolean;
begin
  IsFail := False;

  for I := 0 to TestList.Count-1 do
  begin
    Test := TestList[I];
    try
      Test.Proc();
      WriteLn(Test.Name, ' passed.');
    except

      on E: ETestFail do
      begin
        IsFail := True;
        WriteLn(Test.Name, ' FAILS: ', E.Message);
      end;

      on E: Exception do
      begin
        IsFail := True;
        WriteLn(Test.Name, ' EXCEPTION: ', E.ClassName, ': ', E.Message);
      end;
    end;
  end;

  if IsFail then
  begin
    WriteLn('Some tests fail, press enter');
    ReadLn;
  end
  else 
    WriteLn('OK');

end;

procedure UnregisterTests();
var
  I: Integer;
  Test: PTest;
begin
  for I := TestList.Count - 1 downto 0 do
  begin
    Test := TestList[I];
    Dispose(Test);
  end;
  TestList.Clear();
end;

initialization
  TestList := TList.Create();

finalization
  UnregisterTests();
  TestList.Free();

end.